Se está interesado en estudiar el comportamiento del tiempo hasta que un cliente deja de serlo. Un estudio recabó información de 7043 clientes de una empresa.
A continuación se presentará un reporte que muestra el procedimiento estadístico realizado hasta determinar un modelo de Cox validado para mostrar una solución al problema.
Cada fila representa un cliente, cada columna contiene los atributos del cliente descritos en el diccionario.
El conjunto de datos incluye información a cerca de:
Clientes que se fueron en el último mes: la columna se llama ‘Churn’.
Servicios a los que se ha suscrito cada cliente: teléfono, varias líneas, Internet, seguridad en línea, respaldo en línea, protección de dispositivos, soporte técnico y transmisión de TV y películas.
Información de la cuenta del cliente: cuánto tiempo ha sido cliente, contrato, método de pago, facturación electrónica, cargos mensuales y cargos totales.
Información demográfica sobre los clientes: sexo, rango de edad y si tienen socios y dependientes.
En cualquier grupo de clientes lo suficientemente grande como Telco, habrá personas que tengan las mismas características. Algunos de ellos abandonarán y otros no, y lo que idealmente le gustaría saber a las empresas de telecomunicaciones es la probabilidad de abandono de cada grupo. Esto es lo que proporciona, por ejemplo, la regresión logística. Pero no está claro para qué escala de tiempo está proporcioando esta probabilidad de abandono. Por lo tanto, se realizó un análisis de supervivencia para este propósito.
Los datos se obtienen de de un archivo csv proporcioando. Son 21 variables que contiene el conjunto de datos, 18 tipo factor incluyendo el identificador que es único y 3 tipo numérica.
kable(head(data[,1:8],3))
| customerID | gender | SeniorCitizen | Partner | Dependents | tenure | PhoneService | MultipleLines |
|---|---|---|---|---|---|---|---|
| 7590-VHVEG | Female | 0 | Yes | No | 1 | No | No phone service |
| 5575-GNVDE | Male | 0 | No | No | 34 | Yes | No |
| 3668-QPYBK | Male | 0 | No | No | 2 | Yes | No |
kable(head(data[,9:14],3))
| InternetService | OnlineSecurity | OnlineBackup | DeviceProtection | TechSupport | StreamingTV |
|---|---|---|---|---|---|
| DSL | No | Yes | No | No | No |
| DSL | Yes | No | Yes | No | No |
| DSL | Yes | Yes | No | No | No |
kable(head(data[,15:21],3))
| StreamingMovies | Contract | PaperlessBilling | PaymentMethod | MonthlyCharges | TotalCharges | Churn |
|---|---|---|---|---|---|---|
| No | Month-to-month | Yes | Electronic check | 29.85 | 29.85 | No |
| No | One year | No | Mailed check | 56.95 | 1889.50 | No |
| No | Month-to-month | Yes | Mailed check | 53.85 | 108.15 | Yes |
El conjunto de datos ya vienen en formato ‘tidy data’ y no tiene valores faltantes a excepción de 11 valores de la columna de cargos totales, esto se debe a que el número de meses que el cliente ha permanecido en la empresa(tenure) es de 0. Por lo que se les asignó el valor 0.
# El resumen de las personas que poseen servicio de internet o servicio de teléfono es:
data$has_InternetService <- ifelse(data$InternetService != "No", "Yes", "No")
data$has_InternetService <- as.factor(data$has_InternetService)
resumen <- data %>% count(PhoneService, has_InternetService)
resumen$porcentaje <- paste(round((resumen$n/7035)*100,2),"%",sep = )
kable(resumen)
| PhoneService | has_InternetService | n | porcentaje |
|---|---|---|---|
| No | Yes | 682 | 9.69 % |
| Yes | No | 1526 | 21.69 % |
| Yes | Yes | 4835 | 68.73 % |
Para la construcción del modelo se necesita que las variables tipo factor tengan la característica de ser variables indicadoras. Es decir, para integrar un factor con a posibles valores en el modelo se necesitan a-1 variables indicadoras. Para esto se creó otra tabla sin alterar las variables numéricas y para las 18 variables tipo factor se hicieron a-1 indicadoras donde a son los niveles que toma la variable tipo factor.
Quedó una tabla de 29 variables; el identificador único, 25 variables tipo indicadora y 3 tipo numérica, incluyendo la variable tenure. Por cuestiones de espacio, sólo se muestra una parte de la tabla.
data$gender_d <- ifelse(data$gender != "Male", 1,0 )
data$Partner_d <- ifelse(data$Partner == "Yes", 1,0 )
data$Dependents_d <- ifelse(data$Dependents == "Yes", 1,0 )
data$PaperlessBilling_d <- ifelse(data$PaperlessBilling == "Yes", 1,0 )
data$PhoneService_d <- ifelse(data$PhoneService == "Yes", 1,0 )
data$MultipleLines_d <- ifelse(data$MultipleLines == "Yes", 1,0 )
data$OnlineSecurity_d <- ifelse(data$OnlineSecurity == "Yes", 1,0 )
data$OnlineBackup_d <- ifelse(data$OnlineBackup == "Yes", 1,0 )
data$DeviceProtection_d <- ifelse(data$DeviceProtection == "Yes", 1,0 )
data$TechSupport_d <- ifelse(data$TechSupport == "Yes", 1,0 )
data$StreamingTV_d <- ifelse(data$StreamingTV == "Yes", 1,0 )
data$StreamingMovies_d <- ifelse(data$StreamingMovies == "Yes", 1,0 )
data$has_InternetService_d <- ifelse(data$InternetService != "No", 1, 0)
data_tres_levels <- data %>%
select(InternetService,Contract,PaymentMethod)
data_tres_levels_d <-dummy_cols(data_tres_levels)
data_tres_levels_d<- data_tres_levels_d %>%
select(-c(InternetService,Contract,PaymentMethod))
attach(data)
data_final <- data.frame(customerID,gender_d,SeniorCitizen,Partner_d,Dependents_d,tenure,
PaperlessBilling_d,PhoneService_d,MultipleLines_d,
OnlineSecurity_d,OnlineBackup_d,DeviceProtection_d,
TechSupport_d,StreamingTV_d,StreamingMovies_d,has_InternetService_d,
data_tres_levels_d,MonthlyCharges,TotalCharges,Churn)
kable(head(data_final[,c(1,25:27)]))
| customerID | PaymentMethod_Electronic.check | PaymentMethod_Mailed.check | MonthlyCharges |
|---|---|---|---|
| 7590-VHVEG | 1 | 0 | 29.85 |
| 5575-GNVDE | 0 | 1 | 56.95 |
| 3668-QPYBK | 0 | 1 | 53.85 |
| 7795-CFOCW | 0 | 0 | 42.30 |
| 9237-HQITU | 1 | 0 | 70.70 |
| 9305-CDSKC | 1 | 0 | 99.65 |
Antes de realizar un análisis más detallado, veamos la función de supervivencia estimada por el método de Kaplan-Meier.
Para esto, definimos las variables de interés para el tiempo y la censura. Para este caso tenure es la variable tiempo,que el número de meses que un cliente se ha quedado en la compañía y la variable censura es churn, que es un indicador si el cliente se fue en el último mes o no.
data$Churn <- ifelse(data$Churn=='Yes',1,0 )
data_surv <- Surv(data$tenure, data$Churn)
plot(data_surv, xlab="Semanas", ylab="Función de supervivencia", main="Función de supervivencia Kaplan-Meier", col=1:3)
La gráfica anterior nos da una intuición básica a cerca de los clientes.
La rotación es relativamente baja. Después de 20 meses, la probabilidad de que un cliente no cancele el servicio es ligeramente superior al 80% e incluso después de 72 meses, la probabilidad de que la empresa retenga a uno de sus clientes es del 60%.
Se harán las gráficas de las curvas de supervivencia para las covariables género y si es jubilado y las pruebas de hipótesis para determinar si las funciones de supervivencia de las covariables género y jubilados son iguales, es decir, vamos a determinar si dichas variables influyen o no en el comportamiento del tiempo de la vida para que un cliente abandone o no la empresa.
Las pruebas son las siguientes,para las j subpoblaciones, la hipótesis nula es si las subpoblaciones tienen la misma función de supervivencia y la alternativa es que si existe al menos una subpoblación cuya función de supervivencia no es igual a las demás.En términos de prueba de hipótesis:fit <- survfit(data_surv ~ gender_d, data = data)
ggsurvplot(fit, data = data,
pval = TRUE,
conf.int = TRUE,
)
Las curvas de Supervivencia parecen similares y como el p-valor es mayor a el nivel de significancia 0.05 (0.47), la evidencia no es suficiente para rechazar la hipótesis nula, es decir, la variable género parece no influir en el tiempo de vida en el que una persona es cliente hasta que deja de serlo.
fit <- survfit(data_surv ~ SeniorCitizen, data = data)
ggsurvplot(fit, data = data,
pval = TRUE,
conf.int = TRUE,
)
Las curvas de Supervivencia parecen diferentes y como el p-valor es menor a el nivel de significancia 0.05 (<0.0001), la evidencia es suficiente para rechazar la hipótesis nula, es decir, hay evidencia para afirmar que si una persona es jubilada, este factor, influye en el tiempo de vida en el que una persona es cliente hasta que dejan de serlo.
De esta forma es posible graficar la función de supervivencia para cada covariable. Con la misma prueba de hipótesis, se verifica si estas tienen un impacto en el tiempo de vida.
data_r <- data[,c(c(2:5),c(7:18))]
a<-list()
for (i in 1:16) {
a[[i]]<-survdiff(data_surv ~ data_r[,i], data = data_r, rho = 1)
}
print(a)
## [[1]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=Female 3488 808 791 0.341 0.793
## data_r[, i]=Male 3555 793 809 0.334 0.793
##
## Chisq= 0.8 on 1 degrees of freedom, p= 0.4
##
## [[2]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=0 5901 1202 1335 13.4 95.4
## data_r[, i]=1 1142 399 265 67.7 95.4
##
## Chisq= 95.4 on 1 degrees of freedom, p= <2e-16
##
## [[3]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No 3641 1060 680 212 443
## data_r[, i]=Yes 3402 540 920 157 443
##
## Chisq= 444 on 1 degrees of freedom, p= <2e-16
##
## [[4]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No 4933 1328 1063 66 233
## data_r[, i]=Yes 2110 272 537 131 233
##
## Chisq= 233 on 1 degrees of freedom, p= <2e-16
##
## [[5]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No 682 148 153 0.171 0.221
## data_r[, i]=Yes 6361 1452 1447 0.018 0.221
##
## Chisq= 0.2 on 1 degrees of freedom, p= 0.6
##
## [[6]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No 3390 765 644 22.370 44.603
## data_r[, i]=No phone service 682 148 153 0.171 0.221
## data_r[, i]=Yes 2971 688 803 16.466 39.589
##
## Chisq= 46.6 on 2 degrees of freedom, p= 8e-11
##
## [[7]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=DSL 2421 404 554 40.7 73.3
## data_r[, i]=Fiber optic 3096 1091 712 202.3 428.2
## data_r[, i]=No 1526 105 334 157.3 233.1
##
## Chisq= 470 on 2 degrees of freedom, p= <2e-16
##
## [[8]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No 3498 1261 694 465 974
## data_r[, i]=No internet service 1526 105 334 157 233
## data_r[, i]=Yes 2019 234 573 200 377
##
## Chisq= 975 on 2 degrees of freedom, p= <2e-16
##
## [[9]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No 3088 1082 584 426 796
## data_r[, i]=No internet service 1526 105 334 157 233
## data_r[, i]=Yes 2429 413 683 106 224
##
## Chisq= 815 on 2 degrees of freedom, p= <2e-16
##
## [[10]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No 3095 1061 584 390.2 730
## data_r[, i]=No internet service 1526 105 334 157.3 233
## data_r[, i]=Yes 2422 434 682 90.3 190
##
## Chisq= 753 on 2 degrees of freedom, p= <2e-16
##
## [[11]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No 3473 1249 688 457 952
## data_r[, i]=No internet service 1526 105 334 157 233
## data_r[, i]=Yes 2044 246 578 190 360
##
## Chisq= 954 on 2 degrees of freedom, p= <2e-16
##
## [[12]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No 2810 836 545 155.16 277.5
## data_r[, i]=No internet service 1526 105 334 157.32 233.1
## data_r[, i]=Yes 2707 659 721 5.27 11.5
##
## Chisq= 371 on 2 degrees of freedom, p= <2e-16
##
## [[13]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No 2785 833 537 163.80 290.7
## data_r[, i]=No internet service 1526 105 334 157.32 233.1
## data_r[, i]=Yes 2732 662 729 6.22 13.6
##
## Chisq= 382 on 2 degrees of freedom, p= <2e-16
##
## [[14]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=Month-to-month 3875 1448.6 637 1035 2166
## data_r[, i]=One year 1473 119.9 400 196 311
## data_r[, i]=Two year 1695 31.6 563 502 997
##
## Chisq= 2203 on 2 degrees of freedom, p= <2e-16
##
## [[15]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No 2872 409 649 88.7 175
## data_r[, i]=Yes 4171 1191 951 60.6 175
##
## Chisq= 175 on 1 degrees of freedom, p= <2e-16
##
## [[16]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
##
## N Observed Expected (O-E)^2/E
## data_r[, i]=Bank transfer (automatic) 1544 208 429 113.425
## data_r[, i]=Credit card (automatic) 1522 186 420 130.997
## data_r[, i]=Electronic check 2365 923 462 460.114
## data_r[, i]=Mailed check 1612 283 289 0.109
## (O-E)^2/V
## data_r[, i]=Bank transfer (automatic) 185.951
## data_r[, i]=Credit card (automatic) 212.994
## data_r[, i]=Electronic check 759.383
## data_r[, i]=Mailed check 0.156
##
## Chisq= 839 on 3 degrees of freedom, p= <2e-16
#No se puede guardar el pvalor para ponerlo en otro vector, etc.
Las covariables que no rechazan la hipótesis nula son: PhoneService y Gender. Es decir, para estas dos variables la evidencia no es suficiente para rechazar la hipótesis nula, o sea, las variables Gender y PhoneService no influyen en el tiempo de vida en el que una persona es cliente hasta que deja de serlo.
Ya que para las demás variables su prescencia influye en el tiempo de vida, determinamos las subpoblaciones para las variables que no son dicotómicas que son: InternetService, Contract y PaymentMethod con la prueba de comparaciones múltiples de Peto y Peto. La hipótesis nula es que las subpoblaciones son iguales y la alternativa es que existe no lo son. En otras palabras, si no se rechaza la hipótesis nula entre dos comparaciones, es posible juntar las dos subpoblaciones en una subpoblación. En términos de prueba de hipótesis es:
pairwise_survdiff(Surv(tenure,Churn) ~ InternetService, data = data, p.adjust.method = "bonferroni", rho = 1)
##
## Pairwise comparisons using Peto & Peto test
##
## data: data and InternetService
##
## DSL Fiber optic
## Fiber optic <2e-16 -
## No <2e-16 <2e-16
##
## P value adjustment method: bonferroni
pairwise_survdiff(Surv(tenure,Churn) ~ Contract, data = data, p.adjust.method = "bonferroni", rho = 1)
##
## Pairwise comparisons using Peto & Peto test
##
## data: data and Contract
##
## Month-to-month One year
## One year <2e-16 -
## Two year <2e-16 <2e-16
##
## P value adjustment method: bonferroni
pairwise_survdiff(Surv(tenure,Churn) ~ PaymentMethod, data = data, p.adjust.method = "bonferroni", rho = 1)
##
## Pairwise comparisons using Peto & Peto test
##
## data: data and PaymentMethod
##
## Bank transfer (automatic) Credit card (automatic)
## Credit card (automatic) 1 -
## Electronic check < 2e-16 < 2e-16
## Mailed check 7.6e-14 < 2e-16
## Electronic check
## Credit card (automatic) -
## Electronic check -
## Mailed check < 2e-16
##
## P value adjustment method: bonferroni
La prueba Peto-Peto solamente nos permitió juntar los factores de Credit card y Bank transfer de la covariable PaymentMethod en una sola subpoblación. Las variables dicotómicas que se crearon en la sección pasada se juntaran en una sola que se llama PaymentMethod_BankTransfer_CreditcCard.
data_final$PaymentMethod_BankTransfer_CreditcCard<-data_final$PaymentMethod_Bank.transfer..automatic.+data_final$PaymentMethod_Credit.card..automatic.
Estas observaciones son útiles para que la empresa de telecomunicaciones Telco comprenda la agregación, la tendencia y las posibles percepciones comerciales.
El modelo de Cox trata de ajustar los coeficientes de la función de riesgo utilizando un método de verosimilitud parcial. La ventaja de la regresión de riesgos proporcionales de Cox es que los modelos de supervivencia se pueden ajustar sin el supuesto de distribución.
Para empezar, se ajustó un modelo de cox para todas las covariables.
Para esto, se plantea la prueba de hipótesis para la significancia del modelo y la prueba de hipótesis para considerar variables en el modelo dado que ya las demás ya están consideradas.
Para la prueba de hipótesis para la significancia del modelo, la hipótesis nula es que nunguna variables es significativa y la alternativa es que al menos una variable lo es. En términos de pruebas de hipótesis:
data.model.fit <- coxph(data_surv ~ gender_d+SeniorCitizen+Partner_d+Dependents_d+PaperlessBilling_d+PhoneService_d+MultipleLines_d+OnlineSecurity_d+OnlineBackup_d+DeviceProtection_d+TechSupport_d+StreamingTV_d+StreamingMovies_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+PaymentMethod_Electronic.check+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)
resumen <- summary(data.model.fit)
kable(as.data.frame(resumen$logtest))
| resumen$logtest | |
|---|---|
| test | 5789.037 |
| df | 21.000 |
| pvalue | 0.000 |
Como el p-valor de la prueba de hipótesis para la significancia del modelo es menor a 0.05, dada la muestra, no hay evidencia para afirmar que todas las variables no deban ser consideradas en el modelo.
Para la significancia de las covariables de manera individual si estas deben estar en el modelo dado que las otras ya están las hipótesis nula es: el coeficiente de la covariables es 0 y la alternativa es, el coeficiente de la covariable es distinto de 0. En términos de prueba de hipótesis, es:
resumdataframe <- as.data.frame(resumen$coefficients)
kable(resumdataframe[,c(2,3,5)])
| exp(coef) | se(coef) | Pr(>|z|) | |
|---|---|---|---|
| gender_d | 1.0377914 | 0.0465534 | 0.4255536 |
| SeniorCitizen | 1.0320077 | 0.0565893 | 0.5776982 |
| Partner_d | 0.8455658 | 0.0550536 | 0.0023113 |
| Dependents_d | 0.9060403 | 0.0696607 | 0.1566413 |
| PaperlessBilling_d | 1.1516705 | 0.0565561 | 0.0125294 |
| PhoneService_d | 2.1882107 | 0.4746194 | 0.0989592 |
| MultipleLines_d | 1.0935375 | 0.1260201 | 0.4779817 |
| OnlineSecurity_d | 0.8147341 | 0.1330451 | 0.1235531 |
| OnlineBackup_d | 0.9550748 | 0.1279993 | 0.7195141 |
| DeviceProtection_d | 1.0975193 | 0.1267931 | 0.4630143 |
| TechSupport_d | 0.9325119 | 0.1323960 | 0.5976660 |
| StreamingTV_d | 1.3151177 | 0.2357189 | 0.2451996 |
| StreamingMovies_d | 1.3239701 | 0.2359078 | 0.2342053 |
| InternetService_DSL | 9.1044044 | 0.5957235 | 0.0002092 |
| InternetService_Fiber.optic | 23.8676318 | 1.1604995 | 0.0062616 |
| Contract_One.year | 0.2810844 | 0.1004983 | 0.0000000 |
| Contract_Two.year | 0.0249681 | 0.2007550 | 0.0000000 |
| PaymentMethod_BankTransfer_CreditcCard | 0.6061603 | 0.0755975 | 0.0000000 |
| PaymentMethod_Electronic.check | 0.8806490 | 0.0696927 | 0.0682029 |
| MonthlyCharges | 1.0129440 | 0.0230112 | 0.5762298 |
| TotalCharges | 0.9984627 | 0.0000399 | 0.0000000 |
#Quitaste InternetService_No, PaymentMethod_Mailed.check, Contract_Month.to.month
Las resumen estadístico anterior indican la importancia de las covariables en la predicción del riesgo de abandono.
En la regresión anterior, la salida exp(coef) se interpreta como el factor de proporcionalidad entre el riesgo \(h(t;X )\) y el riesgo base \(h_0\), siendo 1.00 neutral.
Las covariables Partner, PaperlessBilling, Internet Service (DSL o Fiber Optic), contract (1 year & 2 year), Payment Method (Bank Transfer y Credit Card) y Total Charges tienen un p-valor menor a 0.05 y así, son significativas en el modelo, es decir, deben ser consideradas en el modelo ya que las otras están, por tanto, tienen un rol importante en la predicción de la deserción, mientras que todas las demás covariables no son significativas.
Existen varias estrategias para seleccionar el modelo. A continuación se presentará un método interactivo, que es un método general que consiste en 4 pasos.
Se ajusta un modelo para cada una las covariables por separado. Se prueba pa significancia de cada uno de ellos y se consideran como posibles candidatos aquellos que resulten significativos.
data_ind <- data.frame(gender_d,SeniorCitizen,Partner_d,Dependents_d,
PaperlessBilling_d,PhoneService_d,MultipleLines_d,
OnlineSecurity_d,OnlineBackup_d,DeviceProtection_d,
TechSupport_d,StreamingTV_d,StreamingMovies_d, data_tres_levels_d,data_final$PaymentMethod_BankTransfer_CreditcCard,MonthlyCharges,TotalCharges)
exp.coef.ind<-numeric(0)
se.coef.ind<-numeric(0)
p.val.ind<-numeric(0)
resumen.ind<-list()
for (i in 1:26) {
resumen.ind[[i]] <- summary(coxph(data_surv ~ data_ind[,i],data = data_ind, method = "breslow",na.action = na.exclude))
exp.coef.ind[i]<-resumen.ind[[i]]$coefficients[,2]
se.coef.ind[i]<-resumen.ind[[i]]$coefficients[,3]
p.val.ind[i]<-resumen.ind[[i]]$coefficients[,5]
}
conclsig<-ifelse(p.val.ind < 0.05, "Significativa", "No significativa")
resumen.ind<-data.frame(colnames(data_ind),exp.coef.ind,p.val.ind,conclsig)
colnames(resumen.ind)<-c("Covariable","exp(coef)","se(coef)","p-value")
kable(resumen.ind)
| Covariable | exp(coef) | se(coef) | p-value |
|---|---|---|---|
| gender_d | 1.0338046 | 0.4723809 | No significativa |
| SeniorCitizen | 1.7228222 | 0.0000000 | Significativa |
| Partner_d | 0.3795771 | 0.0000000 | Significativa |
| Dependents_d | 0.4091528 | 0.0000000 | Significativa |
| PaperlessBilling_d | 2.0396864 | 0.0000000 | Significativa |
| PhoneService_d | 1.0537182 | 0.5154060 | No significativa |
| MultipleLines_d | 0.7930217 | 0.0000008 | Significativa |
| OnlineSecurity_d | 0.3152984 | 0.0000000 | Significativa |
| OnlineBackup_d | 0.4906618 | 0.0000000 | Significativa |
| DeviceProtection_d | 0.5218460 | 0.0000000 | Significativa |
| TechSupport_d | 0.3304390 | 0.0000000 | Significativa |
| StreamingTV_d | 0.9100727 | 0.0451068 | Significativa |
| StreamingMovies_d | 0.8980513 | 0.0222091 | Significativa |
| InternetService_DSL | 0.6124259 | 0.0000000 | Significativa |
| InternetService_Fiber.optic | 2.8271412 | 0.0000000 | Significativa |
| InternetService_No | 0.2451719 | 0.0000000 | Significativa |
| Contract_Month.to.month | 19.6007664 | 0.0000000 | Significativa |
| Contract_One.year | 0.2874121 | 0.0000000 | Significativa |
| Contract_Two.year | 0.0339392 | 0.0000000 | Significativa |
| PaymentMethod_Bank.transfer..automatic. | 0.4208072 | 0.0000000 | Significativa |
| PaymentMethod_Credit.card..automatic. | 0.3831120 | 0.0000000 | Significativa |
| PaymentMethod_Electronic.check | 3.4778884 | 0.0000000 | Significativa |
| PaymentMethod_Mailed.check | 0.9285194 | 0.2372410 | No significativa |
| data_final.PaymentMethod_BankTransfer_CreditcCard | 0.2860402 | 0.0000000 | Significativa |
| MonthlyCharges | 1.0062159 | 0.0000000 | Significativa |
| TotalCharges | 0.9994512 | 0.0000000 | Significativa |
Bajo la prueba para la significancia de cada una de las covariables por separado. Las variables que por separado resultaron significativas son: SeniorCitizen, Partner_d, Dependents_d, PaperlessBilling_d, MultipleLines_d, OnlineSecurity_d, OnlineBackup_d, DeviceProtection_d, TechSupport_d, StreamingTV_d, StreamingMovies_d, InternetService_DSL, InternetService_Fiber.optic, InternetService_No, Contract_Month.to.month, Contract_One.year, Contract_Two.year, PaymentMethod_BankTransfer_CreditcCard, PaymentMethod_Electronic.check, MonthlyCharges y Total Charges.
Notar que desde el análisis de covariables que afectan el tiempo de Vida habíamos concluido que ni Gender ni PhoneService tenían un impacto en el comportamiento del tiempo de vida.
data.model.fit2 <- coxph(data_surv ~ SeniorCitizen+Partner_d+Dependents_d+PaperlessBilling_d+MultipleLines_d+OnlineSecurity_d+OnlineBackup_d+DeviceProtection_d+TechSupport_d+StreamingTV_d+StreamingMovies_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+PaymentMethod_Electronic.check+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)
resumen2 <- summary(data.model.fit2)
resumdataframe2 <- as.data.frame(resumen2$coefficients)
kable(resumdataframe2[,c(2,3,5)])
| exp(coef) | se(coef) | Pr(>|z|) | |
|---|---|---|---|
| SeniorCitizen | 1.0321420 | 0.0566020 | 0.5762130 |
| Partner_d | 0.8445930 | 0.0549748 | 0.0021240 |
| Dependents_d | 0.9095310 | 0.0695836 | 0.1729562 |
| PaperlessBilling_d | 1.1540200 | 0.0565334 | 0.0112793 |
| MultipleLines_d | 0.9118988 | 0.0618366 | 0.1358431 |
| OnlineSecurity_d | 0.6791419 | 0.0737319 | 0.0000002 |
| OnlineBackup_d | 0.7918271 | 0.0591173 | 0.0000787 |
| DeviceProtection_d | 0.9101953 | 0.0587154 | 0.1090278 |
| TechSupport_d | 0.7763347 | 0.0719943 | 0.0004372 |
| StreamingTV_d | 0.9060152 | 0.0712314 | 0.1658649 |
| StreamingMovies_d | 0.9118841 | 0.0709020 | 0.1932641 |
| InternetService_DSL | 3.5175474 | 0.1643695 | 0.0000000 |
| InternetService_Fiber.optic | 3.6914367 | 0.2861507 | 0.0000050 |
| Contract_One.year | 0.2802938 | 0.1004965 | 0.0000000 |
| Contract_Two.year | 0.0249023 | 0.2009719 | 0.0000000 |
| PaymentMethod_BankTransfer_CreditcCard | 0.6063072 | 0.0755599 | 0.0000000 |
| PaymentMethod_Electronic.check | 0.8780176 | 0.0696267 | 0.0617100 |
| MonthlyCharges | 1.0512150 | 0.0052992 | 0.0000000 |
| TotalCharges | 0.9984666 | 0.0000397 | 0.0000000 |
Así, se descartan todas aquellas que aun cuando por si solas fueron significativas, ya no lo son al incluir otras covariables. De esta forma se retiran las covariables: SeniorCitizen, Dependents_d,MultipleLines_d, DeviceProtection_d, StreamingMovies_d, StreamingTV_d y PaymentMethod_Electronic.check.
Por lo que se hizo un nuevo análisis con las covariables vigentes.
Las variables vigentes son: Partner_d,PaperlessBilling_d,OnlineSecurity_d,OnlineBackup_d,TechSupport_d, InternetService_DSL,InternetService_Fiber.optic,Contract_One.year, Contract_Two.year, PaymentMethod_BankTransfer_CreditcCard, MonthlyCharges y TotalCharges.
data.model.fit3 <- coxph(data_surv ~ Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)
resumen3 <- summary(data.model.fit3)
resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])
| exp(coef) | se(coef) | Pr(>|z|) | |
|---|---|---|---|
| Partner_d | 0.8153549 | 0.0504891 | 0.0000528 |
| PaperlessBilling_d | 1.1404597 | 0.0558391 | 0.0185849 |
| OnlineSecurity_d | 0.7220278 | 0.0678078 | 0.0000016 |
| OnlineBackup_d | 0.8219791 | 0.0553865 | 0.0004009 |
| TechSupport_d | 0.8176351 | 0.0672654 | 0.0027606 |
| InternetService_DSL | 3.9649442 | 0.1479579 | 0.0000000 |
| InternetService_Fiber.optic | 5.4541312 | 0.2013722 | 0.0000000 |
| Contract_One.year | 0.2803912 | 0.0999100 | 0.0000000 |
| Contract_Two.year | 0.0250789 | 0.1999570 | 0.0000000 |
| PaymentMethod_BankTransfer_CreditcCard | 0.6642115 | 0.0556906 | 0.0000000 |
| MonthlyCharges | 1.0411924 | 0.0025955 | 0.0000000 |
| TotalCharges | 0.9984754 | 0.0000390 | 0.0000000 |
Todas las covariables que no se incluyeron en el paso 2, pero que fueron consideradas en el paso 1, tienen posibilidad de ser incluidas en el modelo, por lo que se hace un análisis por separado de las variables vigentes con cada una de ellas cuidando el detalle que si una es incluida no altere la significancia de las otras.
data.model.fit3 <- coxph(data_surv ~ SeniorCitizen+Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)
resumen3 <- summary(data.model.fit3)
resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])
| exp(coef) | se(coef) | Pr(>|z|) | |
|---|---|---|---|
| SeniorCitizen | 1.0296304 | 0.0551229 | 0.5963030 |
| Partner_d | 0.8144684 | 0.0505263 | 0.0000487 |
| PaperlessBilling_d | 1.1375137 | 0.0560650 | 0.0215543 |
| OnlineSecurity_d | 0.7238939 | 0.0679846 | 0.0000020 |
| OnlineBackup_d | 0.8217588 | 0.0553951 | 0.0003944 |
| TechSupport_d | 0.8206574 | 0.0676427 | 0.0034783 |
| InternetService_DSL | 3.9467107 | 0.1481969 | 0.0000000 |
| InternetService_Fiber.optic | 5.4157053 | 0.2018112 | 0.0000000 |
| Contract_One.year | 0.2808951 | 0.0999896 | 0.0000000 |
| Contract_Two.year | 0.0251430 | 0.2000392 | 0.0000000 |
| PaymentMethod_BankTransfer_CreditcCard | 0.6649085 | 0.0557288 | 0.0000000 |
| MonthlyCharges | 1.0411867 | 0.0025953 | 0.0000000 |
| TotalCharges | 0.9984748 | 0.0000390 | 0.0000000 |
data.model.fit3 <- coxph(data_surv ~ Dependents_d+Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)
resumen3 <- summary(data.model.fit3)
resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])
| exp(coef) | se(coef) | Pr(>|z|) | |
|---|---|---|---|
| Dependents_d | 0.9183068 | 0.0679337 | 0.2096551 |
| Partner_d | 0.8369531 | 0.0544262 | 0.0010745 |
| PaperlessBilling_d | 1.1353198 | 0.0559662 | 0.0233476 |
| OnlineSecurity_d | 0.7245547 | 0.0678490 | 0.0000020 |
| OnlineBackup_d | 0.8233230 | 0.0553848 | 0.0004479 |
| TechSupport_d | 0.8195507 | 0.0673049 | 0.0031097 |
| InternetService_DSL | 3.9127944 | 0.1483117 | 0.0000000 |
| InternetService_Fiber.optic | 5.3527601 | 0.2018846 | 0.0000000 |
| Contract_One.year | 0.2821891 | 0.1000784 | 0.0000000 |
| Contract_Two.year | 0.0252765 | 0.2001246 | 0.0000000 |
| PaymentMethod_BankTransfer_CreditcCard | 0.6654040 | 0.0557090 | 0.0000000 |
| MonthlyCharges | 1.0412126 | 0.0025953 | 0.0000000 |
| TotalCharges | 0.9984754 | 0.0000389 | 0.0000000 |
data.model.fit3 <- coxph(data_surv ~ MultipleLines_d+Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)
resumen3 <- summary(data.model.fit3)
resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])
| exp(coef) | se(coef) | Pr(>|z|) | |
|---|---|---|---|
| MultipleLines_d | 0.9697619 | 0.0540185 | 0.5697560 |
| Partner_d | 0.8154872 | 0.0504901 | 0.0000535 |
| PaperlessBilling_d | 1.1413707 | 0.0558514 | 0.0179073 |
| OnlineSecurity_d | 0.7199982 | 0.0679805 | 0.0000013 |
| OnlineBackup_d | 0.8198993 | 0.0555639 | 0.0003518 |
| TechSupport_d | 0.8128270 | 0.0680542 | 0.0023255 |
| InternetService_DSL | 3.9006980 | 0.1506611 | 0.0000000 |
| InternetService_Fiber.optic | 5.3205099 | 0.2060278 | 0.0000000 |
| Contract_One.year | 0.2797191 | 0.0999471 | 0.0000000 |
| Contract_Two.year | 0.0250989 | 0.1998709 | 0.0000000 |
| PaymentMethod_BankTransfer_CreditcCard | 0.6646604 | 0.0557004 | 0.0000000 |
| MonthlyCharges | 1.0417045 | 0.0027362 | 0.0000000 |
| TotalCharges | 0.9984774 | 0.0000391 | 0.0000000 |
data.model.fit3 <- coxph(data_surv ~ DeviceProtection_d+Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)
resumen3 <- summary(data.model.fit3)
resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])
| exp(coef) | se(coef) | Pr(>|z|) | |
|---|---|---|---|
| DeviceProtection_d | 0.9431751 | 0.0560307 | 0.2964261 |
| Partner_d | 0.8166809 | 0.0505159 | 0.0000610 |
| PaperlessBilling_d | 1.1395442 | 0.0558471 | 0.0193337 |
| OnlineSecurity_d | 0.7170774 | 0.0681309 | 0.0000011 |
| OnlineBackup_d | 0.8198972 | 0.0554421 | 0.0003414 |
| TechSupport_d | 0.8166385 | 0.0673101 | 0.0026182 |
| InternetService_DSL | 3.9761531 | 0.1483307 | 0.0000000 |
| InternetService_Fiber.optic | 5.2982463 | 0.2036068 | 0.0000000 |
| Contract_One.year | 0.2822194 | 0.1001831 | 0.0000000 |
| Contract_Two.year | 0.0251774 | 0.2002020 | 0.0000000 |
| PaymentMethod_BankTransfer_CreditcCard | 0.6669761 | 0.0558295 | 0.0000000 |
| MonthlyCharges | 1.0421199 | 0.0027342 | 0.0000000 |
| TotalCharges | 0.9984756 | 0.0000390 | 0.0000000 |
data.model.fit3 <- coxph(data_surv ~ StreamingTV_d+Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)
resumen3 <- summary(data.model.fit3)
resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])
| exp(coef) | se(coef) | Pr(>|z|) | |
|---|---|---|---|
| StreamingTV_d | 0.9519683 | 0.0641313 | 0.4427589 |
| Partner_d | 0.8157021 | 0.0504976 | 0.0000548 |
| PaperlessBilling_d | 1.1442766 | 0.0560037 | 0.0161063 |
| OnlineSecurity_d | 0.7149245 | 0.0690357 | 0.0000012 |
| OnlineBackup_d | 0.8166252 | 0.0560319 | 0.0002999 |
| TechSupport_d | 0.8119477 | 0.0678864 | 0.0021503 |
| InternetService_DSL | 3.8939545 | 0.1501125 | 0.0000000 |
| InternetService_Fiber.optic | 5.0957920 | 0.2201402 | 0.0000000 |
| Contract_One.year | 0.2803128 | 0.0999547 | 0.0000000 |
| Contract_Two.year | 0.0250154 | 0.2000956 | 0.0000000 |
| PaymentMethod_BankTransfer_CreditcCard | 0.6627674 | 0.0557629 | 0.0000000 |
| MonthlyCharges | 1.0428580 | 0.0033293 | 0.0000000 |
| TotalCharges | 0.9984722 | 0.0000392 | 0.0000000 |
data.model.fit3 <- coxph(data_surv ~ StreamingMovies_d+Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)
resumen3 <- summary(data.model.fit3)
resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])
| exp(coef) | se(coef) | Pr(>|z|) | |
|---|---|---|---|
| StreamingMovies_d | 0.9579989 | 0.0636545 | 0.5002569 |
| Partner_d | 0.8151604 | 0.0504926 | 0.0000518 |
| PaperlessBilling_d | 1.1425020 | 0.0559054 | 0.0171739 |
| OnlineSecurity_d | 0.7156998 | 0.0690688 | 0.0000013 |
| OnlineBackup_d | 0.8163633 | 0.0563197 | 0.0003151 |
| TechSupport_d | 0.8122221 | 0.0679937 | 0.0022220 |
| InternetService_DSL | 3.9067490 | 0.1498343 | 0.0000000 |
| InternetService_Fiber.optic | 5.1426679 | 0.2195794 | 0.0000000 |
| Contract_One.year | 0.2798043 | 0.1000336 | 0.0000000 |
| Contract_Two.year | 0.0249797 | 0.2001997 | 0.0000000 |
| PaymentMethod_BankTransfer_CreditcCard | 0.6638143 | 0.0557004 | 0.0000000 |
| MonthlyCharges | 1.0426406 | 0.0033162 | 0.0000000 |
| TotalCharges | 0.9984731 | 0.0000392 | 0.0000000 |
data.model.fit3 <- coxph(data_surv ~ PaymentMethod_Electronic.check+Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)
resumen3 <- summary(data.model.fit3)
resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])
| exp(coef) | se(coef) | Pr(>|z|) | |
|---|---|---|---|
| PaymentMethod_Electronic.check | 0.8743115 | 0.0685703 | 0.0501311 |
| Partner_d | 0.8186098 | 0.0505324 | 0.0000747 |
| PaperlessBilling_d | 1.1500760 | 0.0559953 | 0.0125199 |
| OnlineSecurity_d | 0.7149624 | 0.0679915 | 0.0000008 |
| OnlineBackup_d | 0.8225182 | 0.0553883 | 0.0004194 |
| TechSupport_d | 0.8088102 | 0.0674753 | 0.0016625 |
| InternetService_DSL | 4.0312039 | 0.1480454 | 0.0000000 |
| InternetService_Fiber.optic | 5.5938522 | 0.2016408 | 0.0000000 |
| Contract_One.year | 0.2782587 | 0.0997816 | 0.0000000 |
| Contract_Two.year | 0.0247455 | 0.2000166 | 0.0000000 |
| PaymentMethod_BankTransfer_CreditcCard | 0.6006856 | 0.0752123 | 0.0000000 |
| MonthlyCharges | 1.0416366 | 0.0026048 | 0.0000000 |
| TotalCharges | 0.9984721 | 0.0000390 | 0.0000000 |
Las covariables propuestas para el modelo final son las siguientes. Cada una de las covariables resulta significativa.
data.model.fit3 <- coxph(data_surv ~ Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)
resumen3 <- summary(data.model.fit3)
resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])
| exp(coef) | se(coef) | Pr(>|z|) | |
|---|---|---|---|
| Partner_d | 0.8153549 | 0.0504891 | 0.0000528 |
| PaperlessBilling_d | 1.1404597 | 0.0558391 | 0.0185849 |
| OnlineSecurity_d | 0.7220278 | 0.0678078 | 0.0000016 |
| OnlineBackup_d | 0.8219791 | 0.0553865 | 0.0004009 |
| TechSupport_d | 0.8176351 | 0.0672654 | 0.0027606 |
| InternetService_DSL | 3.9649442 | 0.1479579 | 0.0000000 |
| InternetService_Fiber.optic | 5.4541312 | 0.2013722 | 0.0000000 |
| Contract_One.year | 0.2803912 | 0.0999100 | 0.0000000 |
| Contract_Two.year | 0.0250789 | 0.1999570 | 0.0000000 |
| PaymentMethod_BankTransfer_CreditcCard | 0.6642115 | 0.0556906 | 0.0000000 |
| MonthlyCharges | 1.0411924 | 0.0025955 | 0.0000000 |
| TotalCharges | 0.9984754 | 0.0000390 | 0.0000000 |
Se quiere verificar la proporcionalidad de todos los predictores en el modelo. Para esto se realiza una prueba para checar si existe correlación significativa entre los residuos y una transformación del tiempo (Ln(t)).
Se tiene una prueba de hipótesis por cada variable así como una prueba global, basadas cada una en una correlación entre los residuos asociados(Schoenfeld) a cada variable y el eje de tiempo (Ln(t)).
Para esta prueba un p-valor < 0.05 indica una violación del supuesto de proporcionalidad. En términos de pruebas de hipótesis:
cox.model.fit3 <- cox.zph(data.model.fit3)
cox.model.fit3
## chisq df p
## Partner_d 1.05e+01 1 0.0012
## PaperlessBilling_d 6.97e+01 1 < 2e-16
## OnlineSecurity_d 2.57e+01 1 4.0e-07
## OnlineBackup_d 1.09e+02 1 < 2e-16
## TechSupport_d 5.84e+01 1 2.1e-14
## InternetService_DSL 3.81e+02 1 < 2e-16
## InternetService_Fiber.optic 1.39e+03 1 < 2e-16
## Contract_One.year 2.37e+00 1 0.1234
## Contract_Two.year 1.70e-03 1 0.9672
## PaymentMethod_BankTransfer_CreditcCard 2.92e-02 1 0.8644
## MonthlyCharges 2.89e+03 1 < 2e-16
## TotalCharges 1.45e+03 1 < 2e-16
## GLOBAL 3.11e+03 12 < 2e-16
plot(cox.model.fit3 )
Como el p-valor de la prueba es menor a 0.05, rechazamos la hipótesis nula, así, el supuesto de riesgos proporcionales no se cumple.
A menudo, asumimos que las covariables continuas tienen una forma lineal. Sin embargo, esta suposición debe verificarse.
Para verificar si cada variable debe incluirse en la forma lineal en el modelo se utilizan los residuos martingala. Una gráfica de los residuos martingala contra cada covariable (continua) debe mostrar una tendencia lineal. Asi que si se le ajusta un modelo, este debe mostrar una tendencia de linea recta.
par(mfrow=c(1, 2))
data.model.fit3.martingalas <- residuals(data.model.fit3, type = 'martingale')
X<-as.matrix(data_final[,c("MonthlyCharges", "TotalCharges")])
for (j in 1:2) {
scatter.smooth(X[,j], data.model.fit3.martingalas,type="p", pch=".",xlab = c("MonthlyCharges", "TotalCharges")[j], ylab = "Residuos Martingalas")
}
Como las gráficas tienen forma de línea recta, no existe evidencia en contra de la linealidad.
Se compararán dos subpoblaciones definidas por valores de las covariables incluidas en el modelo final.
El modelo de Cox estimado es el siguiente
\(h(t;X) =\) \(h_0(t)\) exp(- 0.204131756Partner_d + 0.131431437PaperlessBilling_d- 0.325691569OnlineSecurity_d- 0.196040260OnlineBackup_d- 0.201339127TechSupport_d + 1.377491784InternetService_DSL + 1.696373348InternetService_Fiber - 1.271569639Contract_One.year - 3.685727093Contract_Two.year- 0.409154637PaymentMethod_BankTransfer_CreditcCard + 0.040366556MonthlyCharges - 0.001525796TotalCharges)
\(X =\) (Partner_d, PaperlessBilling_d,OnlineSecurity_d,OnlineBackup_d,TechSupport_d,InternetService_DSL,InternetService_Fiber, Contract_One.year ,Contract_Two.year,PaymentMethod_BankTransfer_CreditcCard, MonthlyCharges, TotalCharges)
\(X1 = (1,0,0,0,1,0,1,1,0,0,50,700)\)
Grupo 1: El cliente es socio, no factura electronicamente, no tiene servicio de seguridad online ni un respaldo online, tiene soporte de tecnología, no tiene internet tipo DSL pero sí tiene fibra óptica, su contrato es a un año, no paga con tranferencia o tarjeta, paga al mes 50 y en cargos totales en el año pagó 700.
\(X1 = (1,1,0,0,0,0,1,0,1,1,70,900)\)
Grupo 2: El cliente es socio, sí factura electronicamente, no tiene servicio de seguridad online ni un respaldo online, tampoco soporte de tecnología, no tiene internet tipo DSL pero sí tiene fibra óptica, su contrato es a dos añoS, paga con transferencia o tarjeta ,paga al mes 70 y en cargos totales en el año pagó 900.
exp(- 0.204131756*1 + 0.131431437*0- 0.325691569*0- 0.196040260*0- 0.201339127*1 + 1.377491784*0 + 1.696373348*1 - 1.271569639*1 - 3.685727093*0- 0.409154637*0+ 0.040366556*50 - 0.001525796*700)/exp(- 0.204131756*1 + 0.131431437*1- 0.325691569*- 0.196040260*0- 0.201339127*0 + 1.377491784*0 + 1.696373348*1 - 1.271569639*0 - 3.685727093*1- 0.409154637*1+ 0.040366556*70 - 0.001525796*900)
## [1] 7.303616
\[\frac{h(t;X1)}{h(t;X2)} = 7.3>1 \] El grupo 1 tiene mayor riesgo que el grupo dos, de hecho el riesgo en un tiempo t para el grupo 1 es 7.3 veces el riesgo del grupo 2. Se observa que son muy diferentes las funciones de riesgo. La probabilidad de que una persona abandone la compañía del grupo 1 sea después de un tiempo t, es menor a que la probabilidad de que una persona del grupo 2 abandone después del tiempo t.